home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / DOS.BAS < prev    next >
BASIC Source File  |  1992-07-24  |  13KB  |  469 lines
  1. DECLARE SUB MSDOS ()
  2. DECLARE SUB MSDOSX ()
  3. DECLARE SUB GETDTA (DTA.SEG%, DTA.OFS%)
  4. DECLARE SUB OPENFILE (F$, OMODE%, FHANDLE%)
  5. DECLARE SUB CLOSEFILE (FHANDLE%)
  6. DECLARE SUB WRITEFILE (FHANDLE%, BUF.SEG!, BUF.ADR!, BYTES%)
  7. DECLARE SUB LSEEK (FHANDLE%, SMODE%, FLEN!)
  8. DECLARE SUB GETFIRST (SEARCH$, ATTRIB%)
  9. DECLARE SUB GETNEXT (NERR%)
  10. '   *********************************************************************
  11. '   *                                                                   *
  12. '   *    PROGRAM:  DOS                                                  *
  13. '   *                                                                   *
  14. '   *    DESCRIPTION: DOS FUNCTIONS FOR QUICK BASIC                     *
  15. '   *                                                                   *
  16. '   *                                                                   *
  17. '   *    08/05/87     JOHN M. TAL                                       *
  18. '   *                 ROLLINS MEDICAL/DENTAL SYSTEMS                    *
  19. '   *                 SOUTHFIELD, MI                                    *
  20. '   *                                                                   *
  21. '   *                                                                   *
  22. '   *********************************************************************
  23.  
  24. '   LAST EDIT:  08/05/87      PROGRAMMER: JMT
  25.  
  26. '$INCLUDE: 'QB.BI'
  27.  
  28. OPTION BASE 1
  29. DEFDBL A-Z
  30. DIM inreg%(10), outreg%(10)
  31. COMMON SHARED inreg%(), outreg%(), ax%, bx%, cx%, dx%, DP%, si%, di%, FL%, ds%, es%
  32.  
  33. ax% = 1
  34. bx% = 2
  35. cx% = 3
  36. dx% = 4
  37. bp% = 5
  38. si% = 6
  39. di% = 7
  40. FL% = 8
  41. ds% = 9
  42. es% = 10
  43.  
  44. DEF FNWORD% (N!)
  45.    ' --------------------------------------------
  46.    '  CONVERT A SINGLE PRECISION NUMBER 0 - 65535
  47.    '  INTO EQUIVELANT WORD/INTEGER(%) FOR USE BY
  48.    '  CALL INT86
  49.    ' --------------------------------------------
  50.  
  51.    IF N! > 32767 THEN
  52.       FNWORD% = N! - 65536
  53.    ELSE
  54.       FNWORD% = N!
  55.    END IF
  56.  
  57. END DEF  ' FNWORD%
  58.  
  59. DEF FNWORD! (N%)
  60.    ' --------------------------------------------
  61.    '  CONVERT A WORD INTO SINGLE PRECISION
  62.    '  NUMBER 0 - 65535
  63.    ' --------------------------------------------
  64.  
  65.    IF N% < 0 THEN
  66.       FNWORD! = N% + 32767
  67.    ELSE
  68.       FNWORD! = N%
  69.    END IF
  70. END DEF  ' FNWORD!
  71.  
  72. DEF FNSMOD% (N!, M!)
  73.    WHILE N! > M!
  74.       N! = N! - M!
  75.    WEND
  76.    FNSMOD% = FNWORD%(N!)
  77. END DEF   ' FNSMOD%
  78.  
  79.  
  80.  '  &H00 PROGRAM TERMINATE
  81.  '  &H01 KEYBOARD INPUT
  82.  '  &H02 DISPLAY OUTPUT
  83.  '  &H03 AUXILIARY INPUT
  84.  '  &H04 AUXILIARY OUTPUT
  85.  '  &H05 PRINTER OUTPUT
  86.  '  &H06 DIRECT CONSOLE I/O
  87.  '  &H07 DIRECT CONSOLE INPUT WITHOUT ECHO
  88.  '  &H08 CONSOLE INPUT WITHOUT ECHO
  89.  '  &H09 PRINT (DISPLAY) STRING
  90.  '  &H00 PROGRAM TERMINATE
  91.  '  &H01 KEYBOARD INPUT
  92.  '  &H02 DISPLAY LIFEUP
  93.  '  &H0A BUFFERED KEYBOARD INPUT
  94.  '  &H0B CHECK STANDARD INPUT STATUS
  95.  '  &H0C CLEAR KEYBOARD BUFFER AND INVOKE A KEYBOARD FUNCTION
  96.  '  &H0D DISK RESET
  97.  
  98.  '  &H0F FCB OPEN FILE
  99.  '  &H10 FCB CLOSE FILE
  100.  '  &H11 FCB SEARCH FIRST FILE
  101.  '  &H12 FCB SEARCH NEXT FILE
  102.  '  &H13 FCB DELETE FILE
  103.  '  &H14 FCB SEQUENTIAL READ
  104.  '  &H15 FCB SEQUENTIAL WRITE
  105.  '  &H16 FCB CREATE FILE
  106.  '  &H17 FCB RENAME FILE
  107.  
  108.  '  &H10 FCB CLOSE FILE
  109.  '  &H11 FCB SEARCH FIRS15      NDX
  110.  '  &H1A SET DTA
  111.  '  &H1B ALLOCATION TABKE INFORMATION / DEFAULT DRIVE
  112.  '  &H1C ALLOCATION TABLE INFORMATION FOR SPECIFIC DEVICE / DRIVE INFO
  113.  '  &H21 RANDOM READ
  114.  '  &H22 RANDOM WRITE
  115.  '  &H23 FCB FILE SIZE
  116.  '  &H24 FCB SET RELATIVE RECORD FIELD
  117.  '  &H25 SET INTERRUPT VECTOR
  118.  '  &H26 CREATE NEW PROGRAM SEGMENT
  119.  '  &H27 FCB RANDOM BLOCK READ
  120.  '  &H28 FCB RANDOM BLOCK WRITE
  121.  '  &H29 FCB PARSE FILENAME
  122.  '  &H2A GET DATE
  123.  '  &H2B SET DATE
  124.  '  &H2C GET TIME
  125.  '  &H2D SET TIME
  126.  
  127.  '  &H31 TERMINATE AND STAY RESIDENT
  128.  '  &H33 CONTROL BREAK CHECK
  129.  '  &H35 GET VECTOR
  130.  
  131.  '  &H38 COUNTRY DEPENDENT INFORMATION
  132.  
  133.  '  &H44 I/O CONTROL FOR DEVICES (IOCTL)
  134.  '  &H45 DUPLICATE A FILE HANDLE (DUP)
  135.  '  &H46 FORCE A DUPLICATE OF A HANDLE (FORCDUP)
  136.  
  137.  '  &H48 ALLOCATE MEMORY
  138.  '  &H49 FREE ALLOCATED MEMORY
  139.  '  &H50 MODIFY ALLOCATED MEMORY BLOCKS (SETBLOCK)
  140.  '  &H4B LOAD OR EXECUTE A PROGRAM (EXEC)
  141.  '  &H4C TERMINATE A PROCESS (EXIT)
  142.  '  &H4D GET RETURN CODE OF A SUBPROCESS (WAIT)
  143.  
  144.  '  &H56 RENAME A FILE
  145.  '  &H57 GET/SET A FILES DATE AND TIME
  146.  
  147.  '  &H5A CREATE UNIQUE FILE
  148.  '  &H5B CREATE NEW FILE
  149.  '  &H5C LOCK/UNLOCK FILE ACCESS
  150.  
  151.  '  ---  NETWORK SUPPORT ---
  152.  '  &H5E00 GET MACHINE NAME
  153.  '  &H5E02 SET PRINTER SETUP
  154.  '  &H5E03 GET PRINTER SETUP
  155.  '  &H5F02 GET REDIRECTION LIST ENTRY
  156.  '  &H5F03 REDIRECT DEVICE
  157.  '  &H5F04 CANCEL REDIRECTION
  158.  
  159.  '  &H62 GET PROGRAM SEGMENT PREFIX ADDRESS (PSP)
  160.  '  &H65 GET EXTENDED COUNTRY INFORMATION
  161.  '  &H66 GET/SET GLOBAL CODE PAGE (CHARACTER SET)
  162.  '  &H67 SET HANDLE COUNT
  163.  '  &H68 COMMIT FILE
  164.  
  165. '**************************************************************************
  166.  
  167. PRINT
  168.  
  169.  SUB CHMOD (F$, ATTRIB%, FUNC%) STATIC
  170.     inreg%(ax%) = &H4300 + FUNC%
  171.     F$ = F$ + CHR$(0)
  172.     inreg%(dx%) = SADD(F$)
  173.     inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
  174.     inreg%(cx%) = ATTRIB%
  175.     CALL MSDOSX
  176.     IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
  177.       RES% = outreg%(ax%)
  178.     ELSE
  179.       RES% = 0
  180.       ATTRIB% = outreg%(cx%)  ' ATTRIB RETURNED IF FUNCTION IS GETTING
  181.     END IF
  182.  END SUB
  183.  
  184.  SUB CHNGDIR (F$, RES%) STATIC
  185.     inreg%(ax%) = &H3B00
  186.     F$ = F$ + CHR$(0)
  187.     inreg%(dx%) = SADD(F$)
  188.     inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
  189.     CALL MSDOSX
  190.     IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
  191.       RES% = outreg%(ax%)
  192.     ELSE
  193.       RES% = 0
  194.     END IF
  195.  END SUB
  196.  
  197.  SUB CLOSEFILE (FHANDLE%) STATIC
  198.     inreg%(ax%) = &H3E00   ' CLOSE FILE
  199.     inreg%(bx%) = FHANDLE%
  200.     CALL INT86OLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  201.  END SUB
  202.  
  203.  SUB CREAT (F$, ATTRIB%) STATIC
  204.     inreg%(ax%) = &H3C00
  205.     F$ = F$ + CHR$(0)
  206.     inreg%(dx%) = SADD(F$)
  207.     inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
  208.     CALL MSDOSX
  209.     IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
  210.       RES% = outreg%(ax%)
  211.     ELSE
  212.       RES% = 0
  213.     END IF
  214.  END SUB
  215.  
  216.  SUB CURDRIVE (DRIVE%) STATIC
  217.     inreg%(ax%) = &H1900
  218.     CALL MSDOS
  219.     DRIVE% = outreg%(ax%) MOD 256
  220.  END SUB
  221.  
  222.  SUB DIRFILE (FIRST%, SEARCH$, FOUND$) STATIC
  223.  
  224.  '  CALL DIRFILE(1,"*.BAS",FOUND$)   INITS SEARCH$ AND RETURNS FIRST FOUND$
  225.  '  CALL DIRFILE(2,"*.BAS",FOUND$)   USE ANY VALUE OTHER THAN 1 TO GET NEXT
  226.  '                                     ANY CALL CAN RETURN "EOF"
  227.  '                                     WHICH MEANS NO MORE FILES
  228.  '
  229.  
  230.  FOUND$ = ""
  231.  IF FIRST% = 1 THEN
  232.    ' GET DTA
  233.    CALL GETDTA(DTA.SEG%, DTA.OFS%)
  234.  
  235.    ' MAKE SURE SET TO BASIC SEGMENTS
  236.    DEF SEG
  237.  
  238.    ATTRIB% = 0
  239.    CALL GETFIRST(SEARCH$, ATTRIB%)
  240.  
  241.    IF ATTRIB% <> -1 THEN ' NO FILES
  242.      DEF SEG = DTA.SEG%
  243.      I% = DTA.OFS% + 30
  244.      B% = PEEK(I%)
  245.      WHILE (I% < DTA.OFS% + 42) AND (B% <> 0)
  246.        FOUND$ = FOUND$ + CHR$(B%)
  247.        I% = I% + 1
  248.        B% = PEEK(I%)
  249.      WEND
  250.    ELSE
  251.      FOUND$ = "EOF"
  252.    END IF
  253.  
  254.  ELSE ' NOT FIRST CALL
  255.  
  256.    CALL GETNEXT(NERR%)
  257.  
  258.    IF NERR% = 0 THEN
  259.      DEF SEG = DTA.SEG%
  260.      I% = DTA.OFS% + 30
  261.      B% = PEEK(I%)
  262.      WHILE (I% < DTA.OFS% + 42) AND (B% <> 0)
  263.        FOUND$ = FOUND$ + CHR$(B%)
  264.        I% = I% + 1
  265.        B% = PEEK(I%)
  266.      WEND
  267.  
  268.    ELSE ' LAST FILE
  269.      FOUND$ = "EOF"
  270.    END IF
  271.  
  272.  
  273.  END IF
  274.  
  275.  
  276.  END SUB
  277.  
  278.  SUB GETCURDIR (BUFFER$, DRIVE%) STATIC
  279.     inreg%(ax%) = &H4700
  280.     inreg%(si%) = SADD(BUFFER$)  ' BUFFER$ = 64 BYTES
  281.     inreg%(ds%) = -1  ' QUICK BASICS DATA SEGMENT
  282.     inreg%(dx%) = DRIVE%
  283.     CALL MSDOSX
  284.     IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET
  285.        DRIVE% = -1
  286.     END IF
  287.  END SUB
  288.  
  289.  SUB GETDISKFREE (DRIVE%, DFREE!, DMAX!) STATIC
  290.     inreg%(ax%) = &H3600
  291.     inreg%(dx%) = DRIVE%
  292.     CALL MSDOS
  293.     AVAIL.CL! = FNWORD!(outreg%(bx%))
  294.     CL.DRIVE! = FNWORD!(outreg%(dx%))
  295.     BYTE.SEC! = FNWORD!(outreg%(cx%))
  296.     SEC.P.CL! = FNWORD!(outreg%(ax%))
  297.     IF SEC.P.CL! = &HFFFF THEN ' INVALID DRIVE
  298.       DFREE! = -1
  299.       DMAX! = -1
  300.     ELSE
  301.       DFREE! = AVAIL.CL! * SEC.P.CL! * BYTE.SEC!
  302.       DMAX! = CL.DRIVE! * SEC.P.CL! * BYTE.SEC!
  303.     END IF
  304.  END SUB
  305.  
  306. SUB GETDOSV (MAJOR%, MINOR%) STATIC
  307.    inreg%(ax%) = &H3000
  308.    CALL MSDOS
  309.    MAJOR% = outreg%(ax%) MOD 256
  310.    MINOR% = outreg%(ax%) \ 256
  311. END SUB
  312.  
  313.  SUB GETDTA (DTA.SEG%, DTA.OFS%) STATIC
  314.  
  315.    '  &H25 SET INTERRU34      NDX   FIELD
  316.    inreg%(ax%) = &H2F00
  317.    CALL MSDOSX
  318.    DTA.SEG% = outreg%(es%)
  319.    DTA.OFS% = outreg%(bx%)
  320.  END SUB
  321.  
  322. SUB GETFIRST (SEARCH$, ATTRIB%) STATIC
  323.    inreg%(ax%) = &H4E00
  324.    inreg%(cx%) = ATTRIB%  ' ATTRIBUTE
  325.    SEARCH$ = SEARCH$ + CHR$(0)
  326.    inreg%(dx%) = SADD(SEARCH$)
  327.    inreg%(ds%) = -1
  328.    CALL MSDOSX
  329.    IF (outreg%(FL%) AND 1) = 1 THEN
  330.       ATTRIB% = -1
  331.    END IF
  332. END SUB
  333.  
  334.  SUB GETNEXT (NERR%) STATIC
  335.     inreg%(ax%) = &H4F00
  336.     CALL MSDOS
  337.     IF (outreg%(FL%) AND 1) = 1 THEN
  338.        NERR% = outreg%(ax%)
  339.     ELSE
  340.        NERR% = 0
  341.     END IF
  342.  END SUB
  343.  
  344.  SUB GETVERIFY (VER%) STATIC
  345.     inreg%(ax%) = &H5400
  346.     CALL MSDOS
  347.     VER% = outreg%(ax%) MOD 256
  348.  END SUB
  349.  
  350.  SUB GETXERROR (EXERR!, ERCLASS%, SUGGACT%, LOCUS%) STATIC
  351.     inreg%(ax%) = &H5900
  352.     inreg%(bx%) = 0   ' DOS 3.00 TO 3.30
  353.     CALL MSDOS
  354.     EXERR! = FNWORD!(outreg%(ax%))
  355.     ERCLASS% = outreg%(bx%) \ 256
  356.     SUGACT% = outreg%(bx%) MOD 256
  357.     LOCUS% = outreg%(cx%) \ 256
  358.  END SUB
  359.  
  360.  SUB LSEEK (FHANDLE%, SMODE%, FLEN!) STATIC
  361.     inreg%(ax%) = &H4200 + SMODE%   ' AH = &H42, AL = SMODE%/SEEK MODE
  362.     inreg%(cx%) = INT(FLEN! / 65536)
  363.     inreg%(dx%) = FNSMOD%(FLEN!, 65536)
  364.     inreg%(bx%) = FHANDLE%
  365.     CALL INT86OLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  366.  END SUB
  367.  
  368. SUB MAKEDIR (F$, RES%) STATIC
  369.    inreg%(ax%) = &H3900
  370.    F$ = F$ + CHR$(0)
  371.    inreg%(dx%) = SADD(F$)
  372.    inreg%(ds%) = -1  'QUICK BASIC'S DATA SEGMENT
  373.    CALL MSDOSX
  374.    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
  375.       RES% = outreg%(ax%)
  376.    ELSE
  377.       RES% = 0
  378.    END IF
  379. END SUB
  380.  
  381. SUB MSDOS STATIC
  382.    CALL INT86OLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  383. END SUB
  384.  
  385. SUB MSDOSX STATIC
  386.     CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  387. END SUB
  388.  
  389. SUB OPENFILE (F$, OMODE%, FHANDLE%) STATIC
  390.     inreg%(ax%) = &H3D00 + OMODE%   ' AH = &H3D, AL = OMODE%
  391.     F$ = F$ + CHR$(0)
  392.     inreg%(dx%) = SADD(F$)
  393.     inreg%(ds%) = -1
  394.     CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  395.     IF (outreg%(FL%) AND 1) <> 1 THEN ' CARRY NOT SET
  396.        FHANDLE% = outreg%(ax%)
  397.     ELSE
  398.        FHANDLE% = -1
  399.     END IF
  400. END SUB
  401.  
  402.  SUB READFILE (FHANDLE%, BUF.SEG!, BUF.ADR!, BYTES%) STATIC
  403.     ' CALL READFILE(FHANDLE%,-1,SADD(BUFFER$),255)
  404.     inreg%(ax%) = &H3F00   ' READ FROM FILE
  405.     inreg%(bx%) = FHANDLE%
  406.     inreg%(ds%) = FNWORD%(BUF.SEG!)
  407.     inreg%(dx%) = FNWORD%(BUF.ADR!)
  408.     inreg%(cx%) = BYTES%
  409.     CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  410.  END SUB
  411.  
  412. SUB REMDIR (F$, RES%) STATIC
  413.    inreg%(ax%) = &H3A00
  414.    F$ = F$ + "0"
  415.    inreg%(dx%) = SADD(F$)
  416.    inreg%(ds%) = -1  'QUICK BASIC'S DATA SEGMENT
  417.    CALL MSDOSX
  418.    IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
  419.       RES% = outreg%(ax%)
  420.    ELSE
  421.       RES% = 0
  422.    END IF
  423. END SUB
  424.  
  425. SUB SELDISK (DRIVE%) STATIC
  426.     inreg%(ax%) = &HE00 + DRIVE%
  427. END SUB
  428.  
  429.  ' ------ SPECIAL CONGLOMERATES OF ABOVE FUNCTIONS --------
  430.  SUB TRUNCFILE (F$, FLEN!) STATIC
  431.    ' TRUNCATATES FILE (F$) AT LENGTH (FLEN!)
  432.    CALL OPENFILE(F$, 2, FHANDLE%)
  433.    IF FHANDLE% <> -1 THEN
  434.      CALL LSEEK(FHANDLE%, 0, FLEN!)
  435.      IF (outreg%(FL%) AND 1) <> 1 THEN ' CARRY NOT SET
  436.         CALL WRITEFILE(FHANDLE%, -1, 0, 0)
  437.      END IF
  438.      CALL CLOSEFILE(FHANDLE%)
  439.    END IF
  440.  END SUB
  441.  
  442.  SUB UNLINK (F$) STATIC
  443.     inreg%(ax%) = &H4100
  444.     F$ = F$ + CHR$(0)
  445.     inreg%(dx%) = SADD(F$)
  446.     inreg%(ds%) = -1  ' QUICK BASIC'S DATA SEGMENT
  447.     CALL MSDOSX
  448.     IF (outreg%(FL%) AND 1) = 1 THEN ' CARRY SET = ERROR
  449.       RES% = outreg%(ax%)
  450.     ELSE
  451.       RES% = 0
  452.     END IF
  453.  END SUB
  454.  
  455.  SUB VERIFY (VSWITCH%) STATIC
  456.     inreg%(ax%) = &H2E + VSWITCH%
  457.     CALL MSDOS
  458.  END SUB
  459.  
  460.  SUB WRITEFILE (FHANDLE%, BUF.SEG!, BUF.ADR!, BYTES%) STATIC
  461.     inreg%(ax%) = &H4000   ' WRITE TO FILE
  462.     inreg%(bx%) = FHANDLE%
  463.     inreg%(cx%) = BYTES%        ' TRUNCATE FILE
  464.     inreg%(dx%) = FNWORD%(BUF.ADR!)
  465.     inreg%(ds%) = FNWORD%(BUF.SEG!)
  466.     CALL INT86XOLD(&H21, VARPTR(inreg%(ax%)), VARPTR(outreg%(ax%)))
  467.  END SUB
  468.  
  469.